home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / language / embedded / mcu / float09.arc / GETPUT.SA < prev    next >
Text File  |  1987-03-04  |  21KB  |  718 lines
  1.   TTL  'GET AND PUT ARGUMENTS FROM USER MEMORY'
  2.   NAM  GETPUT
  3. *
  4. *   G E T P U T
  5. *
  6. *    THIS SOURCE INCLUDES 2 CALLABLE SUBROUTINES
  7. *    THAT AID THE FRONT AND BACKEND PROCESSORS
  8. *    TO GET AND PUT ARGUMENTS FROM USER MEMORY TO
  9. *    THE INTERNAL STACK FRAME
  10. *      1. GETARG
  11. *      2. MOVRSL
  12. *
  13. *   MAJOR REVISIONS:
  14. *     REVISER     DATE      REASON
  15. *   JOEL BONEY    021480     ORIGINAL
  16. *   JOEL BONEY    070280     SIZE REDUCTION
  17. *   JOEL BONEY    071080     MORE SIZE REDUCTION
  18. *   JOEL BONEY    072080     FIXED MOVRSL TO RETURN DENRM. NBRS.
  19. *   JOEL BONEY    072580     MOD IREG/ISTACK TO SAVE PARAMETER WD.
  20. *   JOEL BONEY    081480     REMOVE BIAS FROM EXTENDED DENORMALIZED.
  21. *   JOEL BONEY    081980     IMPROVE PERFORMANCE
  22. *   JOEL BONEY    082680     MOVE CODE THAT COPIES TSTAT TO FPCB
  23. *             FROM 'CLSTAK' TO 'TRAP'.
  24. *   JOEL BONEY    082680     DONAN CALLS IOPSET INSTEAD OF IOP
  25. *   JOEL BONEY    082980     UPDATE TO DRAFT 6.0. RM AND RP NO LONGER
  26. *             FORCE NORMALIZE MODE.
  27. *   GREG S    103080     ASSURE THAT THE MSBIT OF EXTENDED INF'S
  28. *             IS A DON'T CARE.
  29. *   GREG S    121680     INSERT TEST SO EXT. NORMALIZED VALUES
  30. *             AT MIN. EXP. DON'T GET TYPED AS NOT NORM.
  31. *
  32. *   COPYRIGHT (C) 1980 BY MOTOROLA
  33. *
  34. *
  35. *********************************************************************
  36. *
  37. ********************************************************************
  38. *
  39. *  LINKING LOADER DEFINITIONS
  40. *
  41.    XDEF  GETARG,MOVRSL,TRAP,IREG,ISTACK,CLSTAK
  42.    XREF  SNORM,LNORM,TFRACT,PREC,IOPSUB,IOPSET
  43. ********************************************************************
  44. *
  45. *
  46. *   G E T A R G
  47. *
  48. *     GET AN ARGUMENT FROM USER MEMORY AND PUT IT IN THE
  49. *     STACK FRAME. DO THE NECESSARY EXPANSION TO INTERNAL
  50. *     FORMAT. IF A NAN OCCURS, CHECK FOR A TRAPPING NAN.
  51. *     IF THE ARGUMENT IS DENORMALIZED, CHECK TO SEE IF
  52. *     IT SHOULD BE NORMALIZED DURING THE EXPANSION.
  53. *
  54. * ON ENTRY:
  55. *     X = POINTER TO LOCATION OF ARGUMENT ON STACK FRAME
  56. *     Y = POINTER TO ARGUMENT IN USER MEMORY
  57. *     U = POINTER TO STACK FRAME
  58. *     FOR CMP B=0 FOR ARG1; B.NE.0 FOR ARG2
  59. *     FOR MOV B=0 FOR ARG2; B.NE.0 FOR RESULT
  60. *     FOR OTHER FUNCTION B= DON'T CARE
  61. *
  62. * ON EXIT:
  63. *     ALL REGISTERS RESTORED EXCEPT CC BITS
  64. *     C = 1 NO TRAPPING NAN OCCURED OR TRAP HANDLER WANTS
  65. *        US TO PROCEED.
  66. *     C = 0 TRAPPING NAN OCCURED AND THE TRAP HANDLER
  67. *        WANTS TO ABORT
  68. *
  69. * NOTE:
  70. *     SINCE GETARG IS CALLED BY NEARLY EVERY FUNCTION, AND
  71. *     SINCE CONSIDERABLE TIME COULD BE SPENT EXPANDING THE
  72. *     ARGUMENTS, GETARG IS WRITTEN TO BE AS FAST AS IS
  73. *     REASONABLY POSSIBLE. CONSIDERABLE BYTE SAVINGS CAN
  74. *     BE OBTAINED IF THE MODIFIER WISHES TO SACRIFICE SPEED.
  75. *
  76. *******************************************************************
  77. *
  78. * THE MAIN PART OF GETARG DETERMINES THE PRECISION OF THE ARGUMENT
  79. * AND THEN CALLS THE APPROPRIATE SUBROUTINE TO HANDLE
  80. * THAT PRECISION OF ARGUMENT
  81. *
  82. GETARG PSHS D               SAVE IT
  83. *  SINCE ALL PRECISIONS HANDLE THE SIGN THE SAME WAY,
  84. *  DO IT ONCE HERE.
  85.   LDA  ,Y              GET SIGN
  86.   ANDA #$80
  87.   STA  SIGN,X              STORE IN STACK FRAME
  88.   LBSR PREC              GET PRECISION OF ARGUMENT
  89.   IFCC EQ              IF SINGLE
  90.     BSR GETSGL
  91.   ELSE
  92.     IF B,EQ,#2
  93.       LBSR GETDBL
  94.     ELSE
  95.       LBSR GETEXT
  96.     ENDIF
  97.   ENDIF
  98.   SEC         NO TRAPPING NAN
  99.   PULS D,PC
  100.   PAGE
  101. *
  102. **************************
  103. *
  104. *  GETSGL - SUBPROCEDURE TO GETARG
  105. *     GET A SINGLE PRECISION ARGUMENT FROM THE USER MEMORY AND
  106. *     PUT IT ON THE STACK FRAME. DO THE EXPANSION TO INTERNAL
  107. *     FORMAT. IF A NAN OCCURS CHECK FOR TRAPPING NAN. IF ARG
  108. *     IS DENORMALIZED, CHECK TO SEE IF IT SHOULD BE NORMALIZED.
  109. *
  110. *  ON ENTRY: SAME AS GETARG EXCEPT B IS UNDEFINED
  111. *  ON EXIT:  SAME AS GETARG EXCEPT D IS DESTROYED
  112. *
  113. **************************
  114. *
  115. GETSGL LDD 2,Y              GET 16 LSB'S OF FRACTION FROM USER MEMORY
  116.   STD FRACT+1,X           STORE THEM ON STACK FRAME
  117.   LDB ,Y              GET SIGN + 7 BITS OF EXPONENT
  118.   LDA 1,Y              GET 1 BIT OF EXPONENT + 7 BITS OF FRACTION
  119.   ROLA                  SHIFT OUT EXPONENT
  120.   ROLB                  SHIFT IN EXPONENT BIT
  121.   LSRA                  SHIFT BACK FRACTION
  122.   ORA #BIT7              ADD EXPLICIT 1.0 BIT
  123.   STA FRACT,X              STORE UPPER 8 BITS OF FRACTION
  124.   CLRA
  125.   SUBD #SBIAS              MAKE EXPONENT 2'S COMPLEMENT
  126.   STD EXP,X              SAVE EXPONENT
  127.   IF D,NE,#-127          IF TYPE NOT ZERO OR DENORMALIZED
  128. *   {MUST BE INFINITY,NAN OR NORMALIZED}
  129.     IF D,NE,#128         IF NORMALIZED
  130.       RTS             EXIT HERE FOR SPEED (Z=1)
  131.     ELSE .             INFINITY OR NAN
  132.       BSR CLREXP         RESET EXPLICIT 1.0 BIT IN FRACTION
  133.       MOVD #$7FFF,(EXP,X)    SET CORRECT EXPONENT
  134.       LBSR TFRACT         SEE IF FRACTION = 0
  135.       IFCC NE             MUST BE A NAN
  136.     BSR  DONAN         GO DO NAN PROCESSING
  137.       ELSE  .             {INFINITY}
  138.     MOVA #TYINF,(TYPE,X) TYPE := INFINITY
  139.       ENDIF
  140.     ENDIF
  141. *
  142.   ELSE    .             { ZERO OR DENORMALIZED}
  143.     BSR  CLREXP          RESET EXPLICIT 1.0
  144.     LBSR  TFRACT         SEE IF FRACTION = 0
  145.     IFCC NE             IF DENORMALIZED THEN
  146.       INC EXP+1,X           EXPONENT = -126
  147.       MOVA #TYNNRM,(TYPE,X)  TYPE := NOT NORMALIZED
  148.       BSR TSTNRM         GO NORMALIZE IF REQUIRED
  149.     ELSE  . {ZERO}
  150.       MOVD #$8000,(EXP,X)    SET CORRECT EXPONENT
  151.       MOVA #TYZERO,(TYPE,X)  TYPE := ZERO
  152.     ENDIF
  153.   ENDIF
  154. SGLOUT RTS
  155. *
  156. *  D O N A N
  157. *
  158. *  SUBROUTINE (OF SORTS) TO DO PROCESSING FOR A NAN
  159. *
  160. *  IF THE NAN IS NON-TRAPPING, THEN TAKE A NORMAL EXIT WITH
  161. *     THE TYPE SET TO NAN.
  162. *
  163. *  IF THE NAN IS A TRAPPING NAN THEN DO THE TRAP AND
  164. *     EXIT TO THE CALLER OF GETARG WITH THE C BIT
  165. *     RETURNED BY THE TRAP HANDLER. I KNOW THIS IS
  166. *     TERRIBLY UNSTRUCTURED BUT IT SAVES MANY BYTES
  167. *     OF CODE AND IMPROVES AVERAGE PERFORMANCE A LOT.
  168. *
  169. *
  170. DONAN  EQU  *
  171.     MOVA #TYNAN,(TYPE,X) TYPE := NAN
  172.     LDA FRACT,X           IF NAN IS TRAPPING NAN THEN
  173.     ROLA             TEST BIT 6 (TRAPPING NAN BIT)
  174.     BMI DON1         IF NOT TRAPPING NAN
  175.       RTS             THEN EXIT TO CALLER
  176. DON1    EQU  *             ELSE
  177.      LDA #5           INVALID OPERATION = 5
  178.      LBSR IOPSET
  179.       LBSR TRAP         GO TRAP IF ENABLED
  180.       LEAS 4,S         RETURN TO CALLER OF GETARG (WITH C)
  181.       PULS D,PC
  182. *
  183. *****************************
  184. *
  185. * CLREXP - CLEAR EXPLICIT 1.0 IN FRACTION
  186. *
  187. CLREXP EQU *
  188.   LSL  FRACT,X              MOVE MSB INT CARRY
  189.   LSR  FRACT,X              MOVE A ZERO BACK
  190.   RTS
  191. *
  192. ***********************
  193. *
  194. * TSTNRM
  195. *   TEST A DENORMALIZED NUMBER TO SEE IF IT SHOULD BE
  196. *   NORMALIZED (NRM SET IN FPCB).
  197. *   IF SO DO THE NORMALIZATION AND SET TYPE
  198. *   TO NORMALIZED.
  199. *
  200. *   DESTROYS A REG
  201. *
  202. TSTNRM EQU *
  203.       LDA [PFPCB,U]         CHECK FOR NORMALIZE MODE
  204.       BITA #CTLNRM
  205.       IFCC NE             IF NORMALIZE MODE
  206.     LBSR SNORM
  207.       ENDIF
  208.       RTS
  209.  PAGE
  210. *
  211. ****************************
  212. *
  213. * GETDBL - SUBPROCEDURE TO GETARG
  214. *
  215. *    GET A DOUBLE PRECISION ARGUMENT FROM THE USER MEMORY
  216. *    AND PUT IT ON THE STACK FRAME. DO THE EXPANSION TO
  217. *    THE INTERNAL FORM. IF A NAN OCCURS, CHECK FOR A
  218. *    TRAPPING NAN. IF ARGUMENT IS DENORMALIZED, CHECK TO
  219. *    SEE IF IT SHOULD BE NORMALIZED.
  220. *
  221. * ENTRY: SAME AS GETARG EXCEPT B IS UNDEFINED
  222. * EXIT:  SAME AS GETARG EXCEPT D IS DESTROYED
  223. *
  224. ******************************
  225. *
  226. *
  227. GETDBL    EQU  *
  228. *  MOVE FRACTION FROM USER MEMORY TO STACK FRAME A BYTE
  229. *  AT A TIME. DO THE NECESSARY SHIFTING ALONG THE WAY
  230.    LDA    #6               PUT LOOP CTR ON STACK
  231.    PSHS A,Y,U               ALONG WITH SOME OTHER REGS
  232.    LEAY 1,Y               Y NOW POINTS TO USER FRACTION
  233.    LEAU FRACT,X            X NOW POINTS TO STACK FRAME FRACT.
  234. DBLOOP EQU *
  235.    LDD    ,Y+               GET 'LAST' BYTE - UPPER 3 BITS ARE
  236. *                   DON'T CARES
  237.    LSLB                SHIFT 3 BITS FROM NEXT
  238.    ROLA                INTO LAST
  239.    LSLB
  240.    ROLA
  241.    LSLB
  242.    ROLA
  243.    STA    ,U+               STORE PARTIAL ANSWER IN STACK FRAME
  244.    DEC    ,S               DEC LOOP CTR
  245.    BNE    DBLOOP
  246.    STB    ,U               STORE LAST 5 BITS
  247.    PULS A,Y,U
  248.   BSETA BIT7,(FRACT,X)        SET EXPLICIT 1.0 IN FRACTION
  249.   LDD  ,Y               GET SIGN PLUS EXPONENT
  250.   SRD  4
  251.   ANDA    #$07
  252.   SUBD    #DBIAS               REMOVE BIAS - MAKE 2'S COMPLEMENT
  253.   STD  EXP,X
  254.   IF D,NE,#-1023          IF NOT ZERO OR DENORMALIZED THEN
  255.     IF D,NE,#1024            IF NORMALIZED THEN
  256.       RTS             EXIT HERE FOR SPEED (Z=1)
  257.     ELSE  .            {INFINITY OR NAN}
  258.       BSR CLREXP        RESET 1.0 BIT IN FRACTION
  259.       MOVD #$7FFF,(EXP,X)    GET CORRECT EXPONENT
  260.       LBSR  TFRACT        IF FRATION NE 0 THEN
  261.       IFCC  NE             {NAN}
  262.     BSR  DONAN           DO NAN PROCESSING
  263.       ELSE            {INFINITY}
  264.     MOVA #TYINF,(TYPE,X)    TYPE := INFINITY
  265.       ENDIF
  266.     ENDIF
  267.   ELSE .              {ZERO OR DENORMALIZED}
  268.     BSR CLREXP            RESET 1.0 BIT IN FRACTION
  269.     LBSR  TFRACT        IF FRACT NE 0 THEN [DENORMALIZED]
  270.     IFCC  NE
  271.       INC EXP+1,X           EXPONENT = -1022
  272.       MOVA #TYNNRM,(TYPE,X)     TYPE := NOT NORMALIZED
  273.       BSR TSTNRM           GO NORMALIZED IF REQUIRED
  274.     ELSE .               {ZERO}
  275.       MOVD #$8000,(EXP,X)      GET CORRECT EXPONENT
  276.       MOVA #TYZERO,(TYPE,X)     TYPE := ZERO
  277.     ENDIF
  278.   ENDIF
  279. DBLOUT    EQU  *
  280.   RTS                  RETURN
  281.   PAGE
  282. *
  283. *
  284. **************************************************************
  285. *
  286. *    GETEXT - SUBPROCEDURE TO GETARG
  287. *
  288. *      GET AN EXTENDED PRECISION ARGUMENT FROM USER MEMORY AND
  289. *      PUT IT ON THE STACK FRAME. DO EXPANSION TO INTERNAL
  290. *      FORMAT. IF A NAN OCCURS CHECK FOR A TRAPPING NAN.
  291. *
  292. *    ENTRY: SAME AS GETARG EXCEPT B IS UNDEFINED
  293. *    EXIT:  SAME AS GETARG EXCEPT D IS DESTROYED
  294. *
  295. **************************************************************
  296. *
  297. GETEXT EQU *
  298.   MOVD (2,Y),(FRACT,X)         MOVE FRACTION ONTO STACK FRAME
  299.   MOVD (4,Y),(FRACT+2,X)
  300.   MOVD (6,Y),(FRACT+4,X)
  301.   MOVD (8,Y),(FRACT+6,X)
  302.   LDD ,Y             GET SIGN AND EXPONENT
  303.   ANDA #$7F             REMOVE SIGN BIT
  304.   IF D,EQ,#$4000         IF ZERO OR DENORMALIZED THEN
  305.     LBSR TFRACT          TEST FRACTION FOR ZERO
  306.     IFCC EQ             IF ZERO THEN
  307.       MOVD #$8000,(EXP,X)      EXPONENT = $8000
  308.       MOVA #TYZERO,(TYPE,X)  TYPE <- ZERO
  309.     ELSE .             {DENORMALIZED}
  310.       MOVD #$C000,(EXP,X)    EXPONENT = -16384
  311.       TST  FRACT,X         SEE IF FRACT IS NORMALIZED
  312.       BMI  EXTOUT         IF SO, EXIT WITH TYPE <- NORMALIZED
  313.       MOVA #TYNNRM,(TYPE,X)  ELSE, TYPE <- NOT NORMALIZED
  314.       LBSR TSTNRM         GO NORMALIZE IF REQUIRED
  315.     ENDIF
  316.   ELSE
  317.     IF D,EQ,#$3FFF         IF INFINITY OR NAN THEN
  318.       LSL  FRACT,X         ASSURE THAT MSB OF FRACT IS 0
  319.       LSR  FRACT,X
  320.       MOVD #$7FFF,(EXP,X)    EXPONENT = $7FFF
  321.       LBSR TFRACT         TEST FRACTION FOR ZERO
  322.       IFCC EQ             IF INFINITY THEN
  323.     MOVA #TYINF,(TYPE,X) TYPE = INFINITY
  324.       ELSE
  325.     LBSR  DONAN         GO DO NAN PROCESSING
  326.       ENDIF
  327.     ELSE .             {PLAIN OLD NUMBER}
  328.       LSLA             CONVERT 15 TO 16 BIT SIGNED EXPONENT
  329.       ASRA
  330.       STD EXP,X          SAVE EXPONENT
  331.       IFTST (FRACT,X),LT,0   IF NORMALIZED THEN
  332.     RTS
  333.       ELSE
  334.     MOVA  #TYNNRM,(TYPE,X) TYPE := NOT NORMALIZED
  335.       ENDIF
  336.     ENDIF
  337.   ENDIF
  338. EXTOUT EQU *
  339.   RTS
  340.   PAGE
  341. *
  342. ***************************************************************
  343. *
  344. *
  345. *  M O V E  R E S U L T
  346. *
  347. *  MOVE RESULT ON STACK FRAME TO USER MEMORY. DO THE
  348. *  NECESSARY COMPACTION TO MEMORY FORMAT.
  349. *
  350. *  ON ENTRY:
  351. *    X = POINTER TO RESULT IN USER MEMORY
  352. *    U = POINTER TO STACK FRAME
  353. *
  354. *  ON EXIT:
  355. *    ALL REGISTERS RESTORED
  356. *
  357. *
  358. *
  359. *******************************************************************
  360. *
  361. * THE MAIN PART OF MOVERESULT DETERMINES THE PRECISION OF THE ARGUMENT
  362. * AND THEN CALLS THE APPROPRIATE SUBROUTINE TO HANDLE THAT
  363. * PRECISION ARGUMENT.
  364. *
  365. MOVRSL    EQU  *
  366.   PSHS    D,Y,CC
  367.   LEAY    RESULT,U         GET PTR TO RESULT ON STACK
  368.   LDB  RPREC,U             GET PRECISION OF RESULT
  369.   IFCC EQ
  370.     BSR  PUTSGL          SINGLE
  371.   ELSE
  372.     IF B,EQ,#2
  373.       BSR   PUTDBL         DOUBLE
  374.     ELSE
  375.       LBSR  PUTEXT         EXTENDED
  376.     ENDIF
  377.   ENDIF
  378.   PULS    D,Y,CC,PC         RETURN
  379.   PAGE
  380. *
  381. *
  382. *********************************************************
  383. *
  384. *  PUTSGL - STORE SINGLE RESULT IN EXTERNAL MEMORY
  385. *
  386. *    MOVE RESULT FROM INTERNAL STACK FRAME TO EXTERNAL
  387. *    RESULT. DO THE NECESSARY COMPACTION
  388. *
  389. *  ON ENTRY:
  390. *    Y = POINTER TO RESULT ON STACK FRAME
  391. *    X = POINTER TO RESULT IN USER MEMORY
  392. *
  393. *  ON EXIT:
  394. *    D AND CC ARE MODIFIED
  395. *
  396. *********************************************************
  397. *
  398. PUTSGL    EQU  *
  399. * MOVE FRACTION OVER
  400.   LDD  FRACT,Y             GET 16 MSB OF FRACTION
  401.   LSLA                 SHIFT OUT 1.0 BIT. WILL BE SHIFTED RIGHT LATER
  402.   STD  1,X
  403.   MOVA    (FRACT+2,Y),(3,X)      MOVE LSB OF FRACTION
  404.   LDD  EXP,Y             GET EXPONENT
  405. *  LOOK FOR SPECIAL CASES
  406.   IF  D,EQ,#$8000         IF ZERO
  407.     CLRA             SET EXPONENT = 0
  408.   ELSE
  409.     IF D,EQ,#$7FFF         IF INFINITY OR NAN
  410.       CLRA             SET EXP = MAX($00FF)
  411.     ELSE             {NORMALIZED OR DENORMALIZED}
  412.       ADDD  #SBIAS         ADD BIAS
  413.       IF D,EQ,#1 IF EXP=1 THEN IT MIGHT BE DENORMALIZED
  414.     IFTST (FRACT,Y),GE,#0  IF MS FRACTION BIT NOT SET THEN
  415.       CLRB               D=0
  416.     ENDIF
  417.       ENDIF
  418.     ENDIF
  419.   ENDIF
  420.   LSRB                 SHIFT LSB OF EXP INTO C
  421.   ROR  1,X             AND INTO FRACTION
  422.   ORB SIGN,Y             SET SIGN
  423.   STB  ,X             STORE EXPONENT AND SIGN
  424.   RTS
  425.   PAGE
  426. *
  427. *********************************************************
  428. *
  429. *  PUTDBL - STORE DOUBLE RESULT IN EXTERNAL MEMORY
  430. *
  431. *    MOVE RESULT FROM INTERNAL STACK FRAME TO EXTERNAL
  432. *    RESULT. DO THE NECESSARY COMPACTION
  433. *
  434. *  ON ENTRY:
  435. *    Y = POINTER TO RESULT ON STACK FRAME
  436. *    X = POINTER TO RESULT IN USER MEMORY
  437. *
  438. *  ON EXIT:
  439. *    D AND CC ARE MODIFIED
  440. *
  441. *********************************************************
  442. *
  443. *
  444. * MACRO USED TO SHIFT DOUBLE RESULT FRACTION
  445. * 1 BIT RIGHT.
  446. *
  447. RIGHT1    MACR
  448.   LSRA
  449.   RORB
  450.   ROR  3,X
  451.   ROR  4,X
  452.   ROR  5,X
  453.   ROR  6,X
  454.   ROR  7,X
  455.   ENDM
  456. *
  457. * ENTER HERE
  458. *
  459. PUTDBL    EQU  *
  460.   BSR  MOVIT             MOVE FRACTION TO USER MEMORY
  461. * POSITION FRACTION IN WORD
  462.   LDD  1,X             GET FIRST 2 BYTES OF FRACTION
  463.   ANDA #$7F             CLEAR OUT 1.0 BIT
  464.   RIGHT1             SHIFT WHOLE THING RIGHT 3 BITS
  465.   RIGHT1
  466.   RIGHT1
  467.   STD  1,X             RESTORE FIRST 2 BYTES OF FRACTION
  468.   LDD  EXP,Y             GET EXPONENT
  469. * LOOK FOR SPECIAL CASES
  470.   IF  D,EQ,#$8000         IF ZERO
  471.     CLRA             SET EXPONENT = 0
  472.   ELSE
  473.     IF D,EQ,#$7FFF          IF INFINITY OR NAN
  474.       LDA #$7             SET EXPONENT = MAX ($7FF)
  475.     ELSE
  476.       ADDD  #DBIAS         ADD BIAS
  477.       IF D,EQ,#1 IF EXP=1 THEN IT MIGHT BE DENORMALIZED
  478.     IFTST (FRACT,Y),GE,#0  IF MS FRACTION BIT NOT SET THEN
  479.       CLRB               D=0
  480.     ENDIF
  481.       ENDIF
  482.     ENDIF
  483.   ENDIF
  484.   SLD  4             SHIFT EXPONENT LEFT 4
  485.   ORB  1,X             OR ON 4 MSB'S OF FRACTION
  486.   ORA SIGN,Y
  487.   STD ,X
  488.   RTS
  489. *
  490. ******************************************************
  491. *
  492. * MOVIT - LOCAL SUBROUTINE TO MOVE 7 BYTE FRACTION
  493. *      FROM 'FRACT,Y' TO '1,X'.
  494. * DESTROYS D
  495. *
  496. MOVIT EQU *
  497.   MOVD    (FRACT,Y),(1,X)
  498.   MOVD    (FRACT+2,Y),(3,X)
  499.   MOVD    (FRACT+4,Y),(5,X)
  500.   MOVA    (FRACT+6,Y),(7,X)
  501.   RTS
  502.   PAGE
  503. *
  504. *********************************************************
  505. *
  506. *  PUTEXT - STORE EXTENDED RESULT IN EXTERNAL MEMORY
  507. *
  508. *    MOVE RESULT FROM INTERNAL STACK FRAME TO EXTERNAL
  509. *    RESULT. DO THE NECESSARY COMPACTION
  510. *
  511. *  ON ENTRY:
  512. *    Y = POINTER TO RESULT ON STACK FRAME
  513. *    X = POINTER TO RESULT IN USER MEMORY
  514. *
  515. *  ON EXIT:
  516. *    D AND CC ARE MODIFIED
  517. *
  518. *********************************************************
  519. *
  520. PUTEXT    EQU  *
  521.   LEAX    1,X             MOVE FRACTION TO EXTERNAL MEMORY
  522.   BSR    MOVIT
  523.   MOVA    (FRACT+7,Y),(8,X)    MOVE 8TH BYTE
  524.   LEAX    -1,X             RESTORE X
  525.   LDD  EXP,Y             GET EXPONENT
  526.   IF D,EQ,#$8000         IF ZERO
  527.     LSRA             SET EXPONENT = 4000
  528.   ELSE
  529.     IF D,EQ,#$7FFF         IF INFINITY OR NAN
  530.       LSRA             SET EXPONENT = #$3FFF
  531.     ELSE             [ NORMALIZED OR NOT NORMALIZED ]
  532.       ANDA  #$7F         CLEAR SIGN BIT
  533.     ENDIF
  534.   ENDIF
  535.   ORA  SIGN,Y             SET SIGN
  536.   STD  ,X             SAVE EXPONENT
  537.   RTS
  538. *
  539.   PAGE
  540. *
  541. *******************************************************************
  542. *
  543. *  T R A P
  544. *
  545. *    CHECK FOR ENABLED TRAPS. GO TO TRAP HANDLER IF TRAP FOUND.
  546. *    IF TRAP OCCURS, THE TRAP HANDLER WILL RECEIVE AN INDEX
  547. *    IN THE A-REGISTER OF:
  548. *    0  INVALID OPERATION
  549. *    1  OVERFLOW
  550. *    2  UNDERFLOW
  551. *    3  DIVIDE BY ZERO
  552. *    4  UNORDERED
  553. *    5  INTEGER OVERFLOW
  554. *    6  INEXACT
  555. *
  556. *    IF MORE THAN ONE ENABLED TRAP OCCURED, THE ONE WITH THE
  557. *    HIGHEST PRIORITY IS TAKEN. 0 HAS HIGHEST PRIORITY AND
  558. *    6 THE LOWEST.
  559. *
  560. *    FOR COMPARES THAT TRAP ON UNORDERED, UNORDERED WILL
  561. *    WILL BE ENABLED FOR THE DURATION OF THIS
  562. *    ROUTINE (NOT PERMANENTLY).
  563. *
  564. *
  565. *  ON ENTRY:
  566. *    U POINTS TO STACK FRAME
  567. *
  568. *  ON EXIT:
  569. *    C = 1 IF NO TRAP OCCURED OR USER TRAP HANDLER WANTS
  570. *       US TO CONTINUE WITH THE ARGUMENT.
  571. *    C = 0 IF TRAP OCCURED AND USER DOES NOT WANT US TO
  572. *       RETURN A RESULT OR TO CONTINUE.
  573. *    CC IS DESTROYED ON EXIT
  574. *
  575. *******************************************************************
  576. *
  577. TRAP  EQU  *
  578.   IFTST  (TSTAT,U),EQ,#0     DO A QUICK EXIT IF NO BITS ARE SET
  579.     SEC
  580.     RTS
  581.   ENDIF
  582.   PSHS    D,X
  583.   LDX  PFPCB,U             GET POINTER TO FPCB
  584.   LDD  TSTAT,U             GET BOTH STATUS BYTES
  585.   BITA #ERRIOP             IOP ERROR?
  586.   IFCC NE
  587.     STB  SS,X             STORE SECONDARY STATUS
  588.   ENDIF
  589.   ORA ERR,X             OR IN CURRENT STATUS BITS
  590.   STA ERR,X             STORE IN USER'S FPCB
  591.   LDB  ENB,X             GET ENABLE BITS
  592.   LDA  FUNCT,U             GET FUNCTION CODE
  593.   BITA #TONUN
  594.   IFCC NE             IF TRAP ON UNORDERED COMPARE THEN
  595.     ORB #ENBUN             ENABLE UNORDERED TRAP
  596.   ENDIF
  597.   ANDB    TSTAT,U          AND WITH ERROR STATUS FROM THIS OPERATION
  598.   IFCC    NE             IF ENABLED ERROR THEN
  599.     LDA  #-1             INIT FOR LOOP INDEX
  600. TRLOOP    EQU  *
  601.     INCA             INCR INDEX
  602.     LSRB             FOUND HIGHEST ENABLED TRAP?
  603.     BCC  TRLOOP          LOOP IF NOT
  604.     PSHS X,Y,U,D         PROTECT REGS FROM USER
  605.     JSR  [TRAPV,X]         GO TO USER TRAP HANDLER
  606.     PULS X,Y,U,D         RESTORE REGS
  607.   ELSE
  608.     SEC              CARRY = 1 = NO TRAP OCCURED
  609.   ENDIF
  610.   LDD #0             CLEAR OUT TEMP STATUS
  611.   STD TSTAT,U
  612.   PULS    X,D,PC
  613. *
  614.   PAGE
  615. *
  616. *********************************************************************
  617. *
  618. * I R E G
  619. *
  620. *   INITIALIZE THE STACK FRAME ON A REGISTER CALL. CREATE THE
  621. *   STACK FRAME AND INITIALIZE MANY OF THE LOCATIONS IN THE
  622. *   STACK FRAME.
  623. *
  624. *   ON ENTRY:
  625. *      A CONTAINS THE FUNCTION NUMBER
  626. *      X CONTAINS TPARAM IF MOVE OR COMPARE
  627. *
  628. *   ON EXIT:
  629. *      ALL REGISTERS RESTORED
  630. *      U-REG POINTS TO NEWLY CREATED STACK FRAME
  631. *
  632. **********************************************************************
  633. *
  634. IREG  EQU  *
  635.   LEAS    -FRMSIZ,S         CARVE OFF SPACE FOR STACK FRAME
  636.   LDU  DREG,S             LOAD PTR TO FPCB
  637. *
  638. *
  639. *   MUTUAL CODE ALSO SHARED BY ISTACK.
  640. *   ASSUMES D IS ON THE STACK WHEN ENTERING HERE
  641. *
  642. IXIT  EQU  *
  643.   STU  PFPCB,S             STORE PTR TO FPCB
  644.   STA  FUNCT,S             SAVE FUNCTION NBR.
  645.   STX  TPARAM,S          SAVE PARAMETER WD (IF ANY)
  646. * CLEAR ALL STACK FRAME ENTRIES FROM 'TYPE1'
  647. * DOWN TO AND INCLUDING STIKY
  648.   LEAU TYPE1+1,S         GET PTR TO TOP OF AREA TO CLEAR
  649.   PSHS D,X,Y             SAVE REGS
  650.   LDD  #0             D=0
  651.   LDX  #0             D,X, AND Y ARE CLEARED (6 BYTES)
  652.   LEAY ,X             Y=0 TOO
  653. * FAST CLEAR TAKES 75 CYLES
  654.   PSHU D,X,Y
  655.   PSHU D,X,Y             6 * 6 = 36 BYTES
  656.   PSHU D,X,Y
  657.   PSHU D,X,Y
  658.   PSHU D,X,Y
  659.   PSHU D,X,Y
  660.   PSHU D,X             + 4 MORE MAKES 40
  661.   LEAU 6,S             U NOW POINTS TO STACK FRAME
  662.   STX  TSTAT,U             CLEAR TSTAT
  663.   INCB                 B=1 (RESULT PRECISION)
  664.   LBSR PREC             GET PRECISION OF RESULT
  665.   STB  RPREC,U
  666.   PULS D,X,Y             RESTORE REGS
  667.   JMP  [ISTKPC,U]         RETURN THRU PC ON STACK
  668. *
  669.   PAGE
  670. *
  671. ******************************************************************
  672. *
  673. * I S T A C K
  674. *
  675. *   INIT STACK FRAME FOR STACK CALL. RESERVES SPACE ON THE
  676. *   STACK AND INITIALIZES SOME VARIABLES.
  677. *
  678. *   ON ENTRY;
  679. *     A CONTAINS THE FUNCTION NBR.
  680. *     Y CONTAINS A POINTER TO THE TOP OF STACK (TOS). ASSUMES
  681. *    THE POINTER TO THE FPCB IS AT TOS-2
  682. *
  683. *   ON EXIT:
  684. *     U-REG POINTS TO STACK FRAMES
  685. *     ALL OTHER REGISTERS RESTORED EXCEPT CC
  686. *
  687. ******************************************************************
  688. *
  689. ISTACK    EQU  *
  690.   LEAS    -FRMSIZ,S         CARVE OFF SPACE FOR STACK FRAME
  691.   STY  PTOS,S             SAVE TOS PTR
  692.   LDU  -2,Y             LOAD PTR TO FPCB
  693.   BRA  IXIT             GO TAKE MUTUAL EXIT WITH IREG
  694. *
  695.   PAGE
  696. *
  697. ******************************************************************
  698. *
  699. * C L S T A K
  700. *
  701. *  CLOSE STACK FRAME. POP THE WHOLE STACK FRAME OFF OF THE STACK
  702. *  BACK TO THE USER'S CCREG
  703. *
  704. *  CAUTION: ANYTHING ON THE STACK BELOW THE STACK
  705. *        FRAME WILL BE LOST
  706. *
  707. *  X IS DESTROYED
  708. *
  709. *******************************************************************
  710. *
  711. CLSTAK    EQU  *
  712.   LDX  ,S            GET RETURN ADDRESS
  713.   LEAS    ,U             CARVE UP TO U
  714.   LEAS    FRMSIZ+2,S         POP STACK FRAME PLUS IREGPC OR ISTKPC
  715.   JMP  ,X             EXIT
  716. *
  717.   PAGE
  718.